library(tidyverse)
library(rvest)
library(tidytext)
library(tokenizers)
library(udpipe)
library(dplyr)
library(ggplot2)
library(readr)Данные
На этой странице:
сбор и предобработка данных. Код и комментарии к нему.
Сбор данных
1. Загружаем все необходимые для нашего исследования библиотеки.
2. Список переводов писем Розы Люксембург размещен на 4 веб-страницах, по 50 url на каждой. Соберем все 184 ссылки.
# первая страница с ссылками (0-50)
url1 <- "https://proza.ru/avtor/cnamibog&s=0&book=45#45"
html1 <- read_html(url1, encoding = "Windows-1251") # читаем html, меняем кодировку
#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget
list_links1 <- html1 |>
html_elements(".poemlink") # загружаем список ссылок
# вторая страница с ссылками (51-100)
url2 <- "https://proza.ru/avtor/cnamibog&s=50&book=45#45"
html2 <- read_html(url2, encoding = "Windows-1251") # читаем html, меняем кодировку
#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget
list_links2 <- html2 |>
html_elements(".poemlink") # загружаем список ссылок
# третья страница с ссылками (101-150)
url3 <- "https://proza.ru/avtor/cnamibog&s=100&book=45#45"
html3 <- read_html(url3, encoding = "Windows-1251") # читаем html, меняем кодировку
#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget
list_links3 <- html3 |>
html_elements(".poemlink") # загружаем список ссылок
# четвертая страница с ссылками (151-184)
url4 <- "https://proza.ru/avtor/cnamibog&s=150&book=45#45"
html4 <- read_html(url4, encoding = "Windows-1251") # читаем html, меняем кодировку
#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget
list_links4 <- html4 |>
html_elements(".poemlink") # загружаем список ссылок3. Создадим таблицу с URL-ссылками на все 184 текста.
# Объединяем списки в один, частичный URL
all_links <- list(list_links1, list_links2, list_links3, list_links4) |>
map_dfr(~ tibble(
title = .x |> html_text2(),
id_text = .x |> html_attr("href")
))
# Выводим объединённую таблицу
print(all_links)# A tibble: 184 × 2
title id_text
<chr> <chr>
1 Другая Роза /2014/04/05/1003
2 второе письмо /2015/04/18/686
3 Только Дело /2014/05/01/568
4 Ежовые рукавицы /2014/04/29/1795
5 Как сердцу высказать себя /2014/05/02/722
6 синяки на душе /2014/05/04/741
7 вторым классом /2015/04/22/694
8 удачная поездка /2015/04/23/918
9 середина лета 1898 года /2015/04/25/1336
10 неловкие попытки /2015/04/27/493
# ℹ 174 more rows
# Добавляем (paste0 += без пробела) протокол доступа и доменное имя.
# Получаем полные URL-адреса страниц с главами повести.
all_links <- all_links |>
mutate(link = paste0("https://proza.ru", id_text))
# select(-id_text) не делаю, id записи = дате публикации
# Извлекаем список всех ссылок
all_roza_urls <- all_links |>
pull(link)
# print(all_roza_urls)4. Скрапинг текста
# Напишем функцию для скрапинга текста
get_text <- function(url){
read_html(url, encoding = "Windows-1251") |>
html_elements(".text") |>
html_text2() |>
paste(collapse=" ")
}
# Применим функцию к полному списку извлеченных ссылок.
# Получаем Large list.
raw_all_roza_texts <- map(all_roza_urls, get_text)
# Превращаем список в символьный вектор, а его в таблицу
raw_roza_texts_tbl <- raw_all_roza_texts |>
flatten_chr() |>
as_tibble()
# Объединяем две таблицы (ссылки, названия текстов и сами тексты)
all_roza_proza <- all_links |>
mutate(text = raw_roza_texts_tbl)Предобработка данных
Чистим данные с помощью регулярных выражений.
# Переименовываем столбец
# Удаляем HTML-теги
# Унифицируем кавычки, апострофы
# Убираем лишние переводы строки (включая пробелы вокруг них), заменяем их на пробел
# Убираем звездочки перед словами (от примечаний)
# Ставим перед записанными с ошибками именами МАРКЕР
all_roza_cleaned <- all_roza_proza |>
mutate(text = text$value) |>
mutate(text = str_remove_all(as.character(text), "<[^>]+>")) |>
mutate(text = str_replace_all(text, "[«»„”‘’]", "\"")) |>
mutate(text = gsub("\\s*\\n+\\s*", " ", text)) |>
mutate(text = gsub("\\b([Нн]и{1,2}у\\S*)", "NIU_\\1", text)) |>
mutate(text = gsub("\\b([Кк]ост\\S*)", "KOSTYA_\\1", text)) |>
mutate(text = gsub("\\b([Юю]{2}\\S*)", "YuYu_\\1", text)) |>
mutate(text = gsub("^[*]+", "", text)) |>
mutate(text = str_replace_all(text, "\\b([Рр]оз(?!енфельд|енталь)(\\S*))", "ROZA_\\1")) |>
mutate(text = gsub("\\b([Мм]ими)", "MIMI_\\1", text)) |>
mutate(text = gsub("\\b([Дд][Цц]ио|[Цц]иу|[Дд]иу)\\S*", "DZIO_\\1", text)) |>
mutate(text = gsub("\\b([Шш]ое|[Шш]оэ|[Шш]\\.)\\S*", "Schönlank_\\1", text)) |>
mutate(text = gsub("\\b([Мм]атиль\\S*)", "MATILDA_\\1", text)) |>
mutate(text = gsub("\\b([Лл]улу)", "LULU_\\1", text))Аннотирование текста
Скачиваем и загружаем модель. Аннотируем.
# Создаем папку models, если её ещё нет
if (!dir.exists("models")) {
dir.create("models")
}
# Добавляем models/ в .gitignore, если её там нет
if (!file.exists(".gitignore")) {
write("models/", file = ".gitignore")
} else {
# Читаем содержимое .gitignore
gitignore_content <- readLines(".gitignore")
# Проверяем, есть ли уже models/
if (!"models/" %in% gitignore_content) {
# Добавляем строку в конец файла, если её нет
write("models/", file = ".gitignore", append = TRUE)
}
}
# Указываем путь к модели
model_path <- "models/russian-syntagrus-ud-2.5-191206.udpipe"
# Проверяем, существует ли файл модели
if (!file.exists(model_path)) {
message("Скачиваем модель...")
udpipe_download_model(language = "russian-syntagrus", model_dir = "models")
} else {
message("Модель уже скачана.")
}
# Загружаем модель
russian_syntagrus <- udpipe_load_model(file = model_path)
# Отобразим текст в документе Quarto
cat("Модель успешно загружена и готова к использованию.")Модель успешно загружена и готова к использованию.
# Скачиваем модель в рабочую директорию
##| echo: false
# udpipe_download_model(language = "russian-syntagrus")
# загружаем модель
##| echo: false
#russian_syntagrus <- udpipe_load_model(file = "russian-syntagrus-ud-2.5-191206.udpipe")
# Оператор присваивания создает переменную params.
params <- tribble(
~tbl, ~output, ~input, ~token,
all_roza_cleaned, "word", "text", "words"
)
params# аннотируем
##| echo: false
all_roza_annotate <- udpipe_annotate(
russian_syntagrus,
all_roza_cleaned$text,
doc_id = all_roza_proza$title)
# преобразуем аннотированное в тибл
##| echo: false
all_roza_ann_tbl <- as_tibble(all_roza_annotate) |>
select(-paragraph_id, -sentence, -xpos) |>
as_tibble()Токенизация
1. Токенизируем.
all_roza_tokens <- all_roza_cleaned |>
unnest_tokens("word",
"text",
to_lower = TRUE,
strip_punct = TRUE) |>
select(-id_text)
all_roza_tokens2. Создаем списки стоп-слов
# Загружаем список список стоп-слов ('nltk')
library(stopwords)
stopwords("ru") [1] "и" "в" "во" "не" "что" "он" "на"
[8] "я" "с" "со" "как" "а" "то" "все"
[15] "она" "так" "его" "но" "да" "ты" "к"
[22] "у" "же" "вы" "за" "бы" "по" "только"
[29] "ее" "мне" "было" "вот" "от" "меня" "еще"
[36] "нет" "о" "из" "ему" "теперь" "когда" "даже"
[43] "ну" "вдруг" "ли" "если" "уже" "или" "ни"
[50] "быть" "был" "него" "до" "вас" "нибудь" "опять"
[57] "уж" "вам" "сказал" "ведь" "там" "потом" "себя"
[64] "ничего" "ей" "может" "они" "тут" "где" "есть"
[71] "надо" "ней" "для" "мы" "тебя" "их" "чем"
[78] "была" "сам" "чтоб" "без" "будто" "человек" "чего"
[85] "раз" "тоже" "себе" "под" "жизнь" "будет" "ж"
[92] "тогда" "кто" "этот" "говорил" "того" "потому" "этого"
[99] "какой" "совсем" "ним" "здесь" "этом" "один" "почти"
[106] "мой" "тем" "чтобы" "нее" "кажется" "сейчас" "были"
[113] "куда" "зачем" "сказать" "всех" "никогда" "сегодня" "можно"
[120] "при" "наконец" "два" "об" "другой" "хоть" "после"
[127] "над" "больше" "тот" "через" "эти" "нас" "про"
[134] "всего" "них" "какая" "много" "разве" "сказала" "три"
[141] "эту" "моя" "впрочем" "хорошо" "свою" "этой" "перед"
[148] "иногда" "лучше" "чуть" "том" "нельзя" "такой" "им"
[155] "более" "всегда" "конечно" "всю" "между"
stopwords_ru <- c(stopwords("ru", source = "nltk"))
# Убираем повторы и упорядочиваем по алфавиту
stopwords_ru <- sort(unique(stopwords_ru))
stopwords_ru [1] "а" "без" "более" "больше" "будет" "будто" "бы"
[8] "был" "была" "были" "было" "быть" "в" "вам"
[15] "вас" "вдруг" "ведь" "во" "вот" "впрочем" "все"
[22] "всегда" "всего" "всех" "всю" "вы" "где" "да"
[29] "даже" "два" "для" "до" "другой" "его" "ее"
[36] "ей" "ему" "если" "есть" "еще" "ж" "же"
[43] "за" "зачем" "здесь" "и" "из" "или" "им"
[50] "иногда" "их" "к" "как" "какая" "какой" "когда"
[57] "конечно" "кто" "куда" "ли" "лучше" "между" "меня"
[64] "мне" "много" "может" "можно" "мой" "моя" "мы"
[71] "на" "над" "надо" "наконец" "нас" "не" "него"
[78] "нее" "ней" "нельзя" "нет" "ни" "нибудь" "никогда"
[85] "ним" "них" "ничего" "но" "ну" "о" "об"
[92] "один" "он" "она" "они" "опять" "от" "перед"
[99] "по" "под" "после" "потом" "потому" "почти" "при"
[106] "про" "раз" "разве" "с" "сам" "свою" "себе"
[113] "себя" "сейчас" "со" "совсем" "так" "такой" "там"
[120] "тебя" "тем" "теперь" "то" "тогда" "того" "тоже"
[127] "только" "том" "тот" "три" "тут" "ты" "у"
[134] "уж" "уже" "хорошо" "хоть" "чего" "чем" "через"
[141] "что" "чтоб" "чтобы" "чуть" "эти" "этого" "этой"
[148] "этом" "этот" "эту" "я"
# Добавляем дополнительные стоп-слова
other <- c(" ", "", "это", "который", "роза",
"весь", "мочь", "свой", "твой", "очень",
"каждый", "ваш", "изза", "поэтому",
"хотя", "сразу", "наш", "все", "еще", "ее", "её",
"тебе", "твое", "кроме", "мои", "dieser", "in",
"der", "dir", "dein", "die", "den", "ich", "und",
"всё", "ещё", "твоё", "моё", "неё", "которые",
"моей", "лишь", "своей", "моего", "которых",
"таких", "таким", "своими", "ними", "также", "мной",
"крайней", "мере", "конце", "концов", "которой",
"которое", "вообще", "свои", "которая", "например",
"такие", "этим", "такую", "эта", "каким", "которую",
"to")3. Удаляем стоп-слова. Делаем две tidy таблицы
# Делаем tidy таблицу с лемматизированными данными:
# Переименовываем колонку lemma
all_roza_ann_tbl <- all_roza_ann_tbl |>
mutate(word = lemma)
# Переводим колонку word в нижний регистр
# Удаляем все знаки препинания из столбца word
# Убираем все комбинации ".»", встречающиеся перед границей слова в столбце lemma
# Удаляем стоп слова + доп. стоп-слова
all_roza_tidy <- all_roza_ann_tbl |>
mutate(word = tolower(str_trim(word))) |>
mutate(word = gsub("[[:punct:]]", "", word)) |>
mutate(lemma = gsub("\\.»\\b", "", lemma)) |>
anti_join(tibble(word = stopwords_ru)) |>
filter(!word %in% other)
all_roza_tidy# Делаем tidy таблицу с токенизированными данными
# Необходимость в токенизированной таблице возникала из-за грязных исходных данных.
# Невычитанный текст с множеством опечаток и ошибок неверно лемматизировался.
rp_token_tidy <- all_roza_tokens |>
anti_join(tibble(word = stopwords_ru)) |>
filter(!word %in% other)
rp_token_tidy